title: “Lab3” output: html_notebook — install packages **Uncomment

library(ggplot2)
## Warning: package 'ggplot2' was built under R version 3.4.2
library(dplyr)
## Warning: package 'dplyr' was built under R version 3.4.2
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(imager)
## Warning: package 'imager' was built under R version 3.4.2
## Loading required package: plyr
## Warning: package 'plyr' was built under R version 3.4.2
## -------------------------------------------------------------------------
## You have loaded plyr after dplyr - this is likely to cause problems.
## If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
## library(plyr); library(dplyr)
## -------------------------------------------------------------------------
## 
## Attaching package: 'plyr'
## The following objects are masked from 'package:dplyr':
## 
##     arrange, count, desc, failwith, id, mutate, rename, summarise,
##     summarize
## Loading required package: magrittr
## Warning: package 'magrittr' was built under R version 3.4.2
## 
## Attaching package: 'imager'
## The following object is masked from 'package:magrittr':
## 
##     add
## The following object is masked from 'package:plyr':
## 
##     liply
## The following objects are masked from 'package:stats':
## 
##     convolve, spectrum
## The following object is masked from 'package:graphics':
## 
##     frame
## The following object is masked from 'package:base':
## 
##     save.image
library(tidyr)
## Warning: package 'tidyr' was built under R version 3.4.2
## 
## Attaching package: 'tidyr'
## The following object is masked from 'package:imager':
## 
##     fill
## The following object is masked from 'package:magrittr':
## 
##     extract
library(reshape2)
## Warning: package 'reshape2' was built under R version 3.4.2
## 
## Attaching package: 'reshape2'
## The following object is masked from 'package:tidyr':
## 
##     smiths

Load test image

im <- load.image("./lab3test.png")
## Warning in readfun(f, ...): libpng warning: iCCP: known incorrect sRGB
## profile
bdf <- as.data.frame(im)
head(bdf,3)
##   x y cc     value
## 1 1 1  1 0.4313725
## 2 2 1  1 0.6156863
## 3 3 1  1 0.7529412
plot(im)

Get info on image

dim(im)
## [1] 1968 1440    1    3

create a histogram for each color channels rgb value frequency

R(im) %>% hist(main="Red Band values Frequency in Test Image");G(im) %>% hist(main="Green Band values Frequency in Test Image");B(im) %>% hist(main="Blue Band values Frequency in Test Image")

Create a data frame to store pic in and create header for df and plot it

picdataframe <- as.data.frame(im)
head(picdataframe,3)
##   x y cc     value
## 1 1 1  1 0.4313725
## 2 2 1  1 0.6156863
## 3 3 1  1 0.7529412

use picture data frame with gg plot to create 3 histograms for each channels pixel freq

picdataframe <- plyr::mutate(picdataframe,channel=factor(cc,labels=c('Red','Green','Blue')))
ggplot(picdataframe,aes(value,col=channel))+geom_histogram(bins=45)+facet_wrap(~ channel)

Plot equlaized image using Empricial Cumulative Distribution Function

hist.eq <- function(im) as.cimg(ecdf(im)(im),dim=dim(im))
split <- imsplit(im,"c")
split
## Image list of size 3
split.eq <- llply(split,hist.eq)
imappend(split.eq,"c") %>% plot(main="3 channel Hist Equalization using Empricial Cumulative Distribution Function")

Perform Image Gradient Magnitude analysis using imageR function

im.g <- grayscale(im)
imgradient(im.g,"xy") %>% enorm %>% plot(main="Gradient magnitude")

im.g
## Image. Width: 1968 pix Height: 1440 pix Depth: 1 Colour channels: 1

Calculating Hessian values using Image gradient

imhessian(im.g)
## Image list of size 3

Determine Determinat of Hessian matrix

Hdet <- with(imhessian(im),(xx*yy - xy^2))
plot(Hdet,main="Determinant of Hessian")

Map the top 1% of Determinant values (high change areas)

threshold(Hdet,"99%") %>% plot(main="Determinant: 1% highest values")

For programs sake label regions

lab <- threshold(Hdet,"99%") %>% label
plot(lab,main="Labeled regions")

Convert to a df, plot df

df <- as.data.frame(lab) %>% subset(value>0)
head(df,3)
##        x y cc value
## 2588 620 2  1     1
## 2599 631 2  1     2
## 4039 103 3  1     3

Calculate center

centers <- ddply(df,.(value),summarise,mx=mean(x),my=mean(y))
plot(im)
with(centers,points(mx,my,col="red"))

Blob detection using multi scalular aproach 1- blur images to reduce noise 2- Determine Hessian values at different zoome levels(scale) 3- Plot deteriment values for each scale using gg plot

hessdet <- function(im,scale=1) isoblur(im,scale) %>% imhessian %$% { scale^2*(xx*yy - xy^2) }
dat <- ldply(c(5,3,4),function(scale) hessdet(im,scale) %>% as.data.frame %>% mutate(scale=scale))
p <- ggplot(dat,aes(x,y))+geom_raster(aes(fill=value))+facet_wrap(~ scale)
p+scale_x_continuous(expand=c(0,0))+scale_y_continuous(expand=c(0,0),trans=scales::reverse_trans())

Combine these scales in to one function

scales <- seq(2,20,l=10)
d.max <- llply(scales,function(scale) hessdet(im,scale)) %>% parmax
plot(d.max,main="Maximum Hessian across scales")

Calculate the max across the multiple scales plot results of max hessian value colored by scale

i.max <- llply(scales,function(scale) hessdet(im,scale)) %>% which.parmax
plot(i.max,main="Maximum Hessian Value across scales")

Use ggplot to plot the grey scale imagery plus the mean centers of highest .1% of hessian values with triangles over top of them (size of the triangle indicates how many times the center was picked up in the multi scale analysis)

labs <- d.max %>% threshold("99.9%") %>% label %>% as.data.frame
labs <- mutate(labs,index=as.data.frame(i.max)$value)
regs <- dplyr::group_by(labs,value) %>% dplyr::summarise(mx=mean(x),my=mean(y),scale.index=mean(index))
p <- ggplot(as.data.frame(im),aes(x,y))+geom_raster(aes(fill=value))+geom_point(data=regs,aes(mx,my,size=scale.index),pch=2,col="red")
p+scale_fill_gradient(low="black",high="white")+scale_x_continuous(expand=c(0,0))+scale_y_continuous(expand=c(0,0),trans=scales::reverse_trans())

Testing capabilities of spectral plots. In the future will be workint to gather spectral plots of pixels located by the local maximas within at least 2 scales

imrow(G(im),60) %>% plot(main="Green 60th row",type="l")

Applying a smoothing threadhold based linear Model

d <- as.data.frame(im)
m <- sample_n(d,1e4) %>% lm(value ~ x*y,data=.) 
im.c <- im-predict(m,d)
out <- threshold(im.c)
plot(out)

testing Gaussian Blur effect

imblur<-grayscale(isoblur(im,5, gaussian =TRUE))
plot(imblur)

plot(im)

Dividing image based on imageR threshold- not to usesful

threshold(imblur) %>% plot

Playing with methods of plotting multiple spectral plots first attempt

both<-("./plots.csv")
bothDf<-read.csv(both)
ggplot(data = bothDf, aes(x=WaveLength, y=Rrs_sim)) + geom_line(aes(y=Rrs_sim, colour=Rrs_sim)) +geom_line(aes(y=Rrs_lid, colour=Rrs_lid))

2nd attempt with data “melted” into long form

melted.both <- melt(bothDf, id="WaveLength")  # convert to long format
ggplot(data = melted.both,
       aes(x=WaveLength, y=value, colour=variable)) +
       geom_line()